home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / Obrn-A_1.6_src.lha / oberon-a / texts2.lha / texts / TechNotes.Text < prev   
Text File  |  1994-05-12  |  53KB  |  1,360 lines
  1. Departement Informatik
  2. Institut für Computersysteme
  3. Eidgenössische Technische Hochschule
  4. Zürich
  5.  
  6. ----------------------------------------------------------------------------
  7.  
  8. Oberon Technical Notes
  9.  
  10. Cuno Pfister (ed.)
  11.  
  12. The purpose of the Oberon technical notes is to provide the implementor
  13. of an Oberon system with the experience gained during the implementation
  14. efforts undertaken at the Institut für Computersysteme at ETH.
  15. Furthermore they give an overview over work already done or under way.
  16. This report contains the first five technical notes.
  17.  
  18. Table of Contents
  19.  
  20. 1. Oberon Implementations page 28
  21.  
  22. 2. An Integrated Heap Allocator/Garbage Collector page 30
  23.  
  24. 3. Type Guards and Type Tests page 40
  25.  
  26. 4. A Symmetric Solution to the Load/Store Problem page 42
  27.  
  28. 5. Garbage Collection on Open Arrays page 48
  29.  
  30. ----------------------------------------------------------------------------
  31.  
  32. 1. Oberon Implementations
  33.  
  34. Cuno Pfister
  35.  
  36. The original Oberon implementation [1] has been realized by N. Wirth and
  37. J. Gutknecht for the Ceres workstation [2]. Several ports of the system
  38. to other machines have been completed since then. We will give a short
  39. description of each of those projects. Differences to the original
  40. implementations are described.
  41.  
  42. Ceres (National Semiconductor NS32x32)
  43.  
  44. The original implementation. Oberon is the basic operating system.
  45. Module Display is written in assembly language. The garbage collector is
  46. a mark-and-sweep garbage collector which runs only between commands,
  47. i.e. it does not need to handle pointers on the stack. An access to a
  48. freed module results in a trap on the Ceres-1 and Ceres-2, but goes
  49. undetected on the Ceres-3. The heap allocator/garbage collector is
  50. written in assembly language and linked together with the inner core
  51. modules.
  52.  
  53. Sun  SPARCstation (Sun SPARC)
  54.  
  55. This implementation [3] runs on top of SunOS as a Unix process. Oberon
  56. takes over the whole screen. The display operations are based on the SUN
  57. Pixrect routines. Oberon files are mapped to Unix files. A variant of
  58. the buddy system strategy is used for heap allocation. The garbage
  59. collector is a mark-and-sweep garbage collector which usually runs
  60. between commands, but when NEW fails due to a memory shortage, the
  61. garbage collector is started also. This collector also takes pointers on
  62. the stack into account. This is done by treating each memory location on
  63. the stack as a possible pointer value. To find out whether a memory word
  64. is a pointer, it is subjected to some plausibility tests, such as
  65. testing whether the value points to a possible block address in the heap
  66. and whether a possibly valid type tag is found there. If the
  67. plausibility tests succeed, the heap is traversed sequentially to find
  68. the corresponding block. If the block is found, the tested memory
  69. location is treated as a root for the garbage collector. Modules are
  70. never freed but merely removed from the module list, i.e. an access to a
  71. freed module cannot be detected and aborted. The loader and heap
  72. allocator/garbage collector are written in Modula-2 and linked as a Unix
  73. application.
  74.  
  75. Apple  Macintosh II (Motorola MC68020)
  76.  
  77. This implementation [4, 5] runs on top of the MacOS as a (MultiFinder
  78. friendly) application. Oberon runs in one Macintosh window. The display
  79. operations are largely based on the Apple QuickDraw routines. Oberon
  80. files are mapped to Macintosh files. An integrated allocator/collector
  81. is used (see technical note # 2). Modules are never freed but merely
  82. removed from the module list, i.e. an access to a freed module cannot be
  83. detected and aborted. The type descriptors contain information about
  84. procedure variables in records, such that a checked version of the
  85. System.Free command could be implemented in the future. The loader, heap
  86. allocator/garbage collector and some raster operations are written in
  87. assembly language and linked as a Macintosh application.
  88.  
  89. DEC  DECstation (MIPS R2000)
  90.  
  91. This implementation runs on top of Ultrix as a process. Oberon runs in
  92. an X-window. The display operations are based on X-windows. Oberon files
  93. are mapped to Ultrix files. An integrated allocator/collector is used
  94. (see technical note # 2). Modules are never freed but merely removed
  95. from the module list, i.e. an access to a freed module cannot be
  96. detected and aborted. The loader is written in C and linked as a Unix
  97. application.
  98.  
  99. IBM  S/6000 (IBM S/6000)
  100.  
  101. This project has recently been started.
  102.  
  103. IBM  PS/2 (Intel 80386)
  104.  
  105. This project has recently been started.
  106.  
  107. Others
  108.  
  109. Other Oberon compiler back-ends have been written by students, but the
  110. system was not ported. The compiler back-ends available produce code for
  111. the following processors:
  112.  
  113.   - a virtual stack machine (similar to P-Code or M-Code)
  114.   - Intel 8086
  115.   - Intel 80386
  116.   - INMOS T800 Transputer
  117.   - C language (Oberon subset to C translator, for bootstrapping a compiler)
  118.  
  119. References
  120.  
  121. 1. Wirth N, Gutknecht J (1989), The Oberon System, Software-Practice and
  122. Experience, 19 (9), 857-893
  123.  
  124. 2. Eberle H (1987), Development and Analysis of a Workstation Computer,
  125. Ph. D. thesis no. 8431, ETH Zürich
  126.  
  127. 3. Templ J (1990), SPARC-Oberon, User's Guide and Implementation, Report
  128. 133, ETH Zürich
  129.  
  130. 4. Franz M (1990), The Implementation of MacOberon, Report 141, ETH
  131. Zürich
  132.  
  133. 5. Franz M (1990), MacOberon Reference Manual, Report 142, ETH Zürich
  134.  
  135. ----------------------------------------------------------------------------
  136.  
  137. 2. An Integrated Heap Allocator/Garbage Collector
  138. Beat Heeb, Cuno Pfister
  139.  
  140. Abstract
  141.  
  142. Heap Allocation and Garbage Collection are fundamental services of an
  143. Oberon implementation. It is shown how a simple and efficient
  144. implementation of these services can be attained.
  145.  
  146. Introduction
  147.  
  148. Programs for personal computers become increasingly loaded with
  149. features, most of them rarely needed. The reason for that is, apart from
  150. the marketing pressure to advertise more features than the competition,
  151. the desire to provide all the features that anyone might ever need or
  152. want. The result is that programs become ever larger, more complex,
  153. buggier, more expensive and sometimes delivered years after their
  154. announcements. Even then they often fail to provide features useful for
  155. a particular task. A solution to this problem lies in the development of
  156. extensible programs. Extensibility here means that a program can provide
  157. the customer with only the features needed most of the time and with
  158. some means to extend it. If the customer needs some special service, he
  159. (or usually a third party) can implement this service himself, without
  160. having access to the original program's source code.
  161.  
  162. For example, imagine an extensible page layout program which supports
  163. text boxes, draw boxes and bitmap boxes as standard box types, and
  164. commands to operate upon them. A user may have special needs concerning
  165. the available commands, like e.g. a command which aligns the selected
  166. objects in a document in a special way. It should be possible for him to
  167. write such a command, which operates on the exported document data
  168. structure. This poses a subtle problem, though. The command implementor
  169. may generate references, i.e. pointers, to an exported data structure,
  170. and these references are not known to the basic layout program. This
  171. means in particular that when the layout program disposes of the storage
  172. used by a document, there may still be pointers around which reference
  173. this storage. Such pointers are called dangling pointers . Dangling
  174. pointers are one of the most frequent and most dangerous sources of
  175. program malfunctions. Their use often results in the destruction of data
  176. not belonging to the erroneous module, and the destruction may not be
  177. detected for a long time. Such an error is difficult to track down,
  178. consequently it is difficult to determine who is responsible for an
  179. accident caused by the error. So extensibility leads to a loss of
  180. control over references and thereby to an increased probability for
  181. dangling pointers. We will come back to that shortly.
  182.  
  183. The user of a program like the one described above should also be able
  184. to write an extension that supports special table boxes, for instance.
  185. Such an extension consists of a module which implements the data type
  186. Table, together with the particular behaviour of an instance of this
  187. type, like displaying, storing and reading itself. A document might then
  188. contain text boxes together with table boxes at the same time. This
  189. example is typical in that a new data type, which is similar to existing
  190. types, is introduced, and that variables of similar data types are
  191. integrated in the same data structure (the document). The
  192. object-oriented programming style is well suited for the implementation
  193. of such a program, since it allows the definition of similar, i.e.
  194. compatible types (e.g. Table is a subtype of Box) and since control can
  195. be delegated to the subtype by means of the overriding facility (e.g.
  196. Table implements its own Draw method). For our discussion the terms
  197. record and object can be used interchangeably.
  198.  
  199. Our example has shown the integration of different objects types,
  200. potentially implemented by different programmers, in the same data
  201. structure. Close integration is obviously useful. On the other hand, it
  202. magnifies the problems associated with malfunctioning objects by making
  203. the integrity of a data structure dependant on a potentially large
  204. number of object implementations. Especially errors which have non-local
  205. effects are dangerous. This leads us to the conclusion that while
  206. extensibility makes dangling pointers more probable, integration of
  207. extensions makes the effects of dangling pointers graver.
  208.  
  209. It is possible to prevent this type of errors going undetected by using
  210. a type-safe language. To prevent dangling pointers, the implementation
  211. of a type-safe language must guarantee that every pointer variable is
  212. initialized correctly and that a heap record is only released when there
  213. are no pointers referencing it anymore. The latter task is performed by
  214. a garbage collector. When a garbage collector can prove that a heap
  215. record is not referenced anymore, it reclaims the corresponding heap
  216. area for the storage allocator. Automatic garbage collection is known
  217. for a long time, but has not found its way into production languages
  218. like Pascal or C, not even into their object-oriented descendants. A
  219. garbage collector may reduce the response time and the performance of a
  220. program dramatically, or may require memory sizes several times as large
  221. as would be the case without a garbage collector. Additional reasons why
  222. garbage collectors are not popular are the problems caused by the lack
  223. of type-safety in the mentioned languages, e.g. posed by untagged
  224. variant records, and the complexity involved in handling arbitrary
  225. record types.
  226.  
  227. We want to show how a simple and efficient garbage collector for Oberon
  228. [1] can be written. Oberon is a type-safe language derived from Modula-2
  229. which allows for an object-oriented programming style. Oberon is also
  230. the name of an operating system and window system [2]. The kernel of an
  231. Oberon system provides, among other things, a storage allocator and a
  232. garbage collector. Oberon has first been implemented on the Ceres
  233. workstation [3]. Our approach is not a radical departure from the Ceres
  234. implementation, but rather a refinement which improves upon memory
  235. utilization and implementation complexity.
  236.  
  237. Heap  Allocation
  238.  
  239. A simple storage allocation algorithm is presented.
  240.  
  241. Small Blocks
  242.  
  243. Storage is allocated in blocks. Block sizes are multiples of a minimal
  244. size B . The size s of an allocated block is at least the size of
  245. variables of the record type bound to the pointer type of p . This size
  246. is known during compilation. For the allocation it is rounded up to the
  247. next multiple of B . There is a free list for all supported block sizes,
  248. i.e. free blocks of the same size are linked by a simple linear list.
  249. The free lists are anchored in a global array A (which could be declared
  250. as ARRAY 1..N OF ADDRESS ) with element number i corresponding to the
  251. free list for size i * B. Allocation of a block of size s consists in
  252. removing a block from free list A[k] where
  253.  
  254.   (k = s / B) (i: s / B i < k: A[i] = NIL) (A[k] NIL).
  255.  
  256. If k = s / B then the address of the block is returned. If k > s / B
  257. then the block is split into two blocks, the first of size s and the
  258. second of size r = k * B - s . The second block is inserted in the free
  259. list A[r / B] and the address of the first block is returned.
  260.  
  261. The Ceres implementation is different in that it uses blocks with sizes
  262. restricted to powers of two. This leads to an increased internal
  263. fragmentation of the memory. In our scheme, each heap variable wastes
  264. less than half of the minimal block size. This in contrast to a waste of
  265. less than half of the particular block size. The most notable other
  266. difference is that our scheme is simpler to implement.
  267.  
  268. Large Blocks
  269.  
  270. It is reasonable to restrict the size of array A such that it supports
  271. only small blocks (e.g. less than about 100 bytes). Almost all
  272. allocations are done with small block sizes, thus a less efficient
  273. allocation strategy can be used for large blocks. A very simple solution
  274. is to use A[N] as a free list for blocks of variable size (i.e. size³ (N
  275. + j) * B ) and performing a first fit allocation [4] whenever this list
  276. must be used. Note that the support for this special case fits naturally
  277. into the allocation procedure, it merely adds one line of code. The
  278. following pseudo-code listing shows the complete allocation routine:
  279.  
  280. procedure Allocate(var a:address; size:longint);
  281.   var i:integer; r, l:address;
  282. begin
  283.   i := min(size / B, N);
  284.   (* calculate index and restrict it to a maximal value *)
  285.   while (i < N) & (A[i] = NIL) do
  286.     INC(i)
  287.   end;
  288.   (* search smallest non-empty free list *)
  289.   l := adr (A[i]); a := l^;
  290.   (* address and value of pointer to first free block *)
  291.   while (a # NIL) & (a^.size < size) do
  292.     l := ADR(a^.next); a := l^
  293.   end;
  294.   (* first fit if i = N *)
  295.   if a # nil then
  296.     l^ := a^.next;
  297.     (* remove block from free list *)
  298.     if a^.size > size then
  299.       (* block must be split *)
  300.       i := min ((a^.size - size) / B, N); r := a + size;
  301.       r^.size := a^.size - size;
  302.       (* adjust size of residual block *)
  303.       r^.next := A[i]; A[i] := r
  304.       (* insert residual block in free list *)
  305.     end
  306.   end
  307. end Allocate;
  308.  
  309. This algorithm doesn't support fast arbitrary block deallocation,
  310. because a freed block cannot efficiently be merged with its
  311. lower-address neighbour and because only simple linear lists are used
  312. for the free lists, which prohibits fast removal of a block from its
  313. free list. In the next chapter we will show how a garbage collector
  314. circumvents the need for fast arbitrary block deallocation.
  315.  
  316. Garbage  Collection
  317.  
  318. The Ceres implementation of Oberon uses a mark-and-sweep garbage
  319. collector [5] for heap storage reclamation. In Oberon, most temporary
  320. variables are local and therefore allocated and deallocated on the
  321. stack. Thus relatively little garbage is produced compared to typical
  322. Lisp or Smalltalk systems. This explains why the Ceres garbage collector
  323. proved adequate in practice, contradicting the statement that
  324. "Mark-and-sweep automatic storage reclamation does not seem to be
  325. practical on contemporary (1988) computers" [6].
  326.  
  327. A mark-and-sweep collector works in two phases. In the mark phase, all
  328. objects which still can be referenced are marked. In the sweep phase,
  329. all heap blocks are traversed sequentially. The ones which have not been
  330. marked are reclaimed.
  331.  
  332. Mark Phase
  333.  
  334. Let us first consider a simple recursive procedure, which marks all
  335. objects reachable from a given pointer:
  336.  
  337. procedure Mark(q:address);
  338.   var off:address;
  339. begin
  340.   if (q # NIL) & (Unmarked(q)) then
  341.     SetMark(q); off := FirstPointerOffset(q);
  342.     while off >= 0 do
  343.       Mark(mem[q + off]); off := NextPointerOffset(q, off)
  344.     end
  345.   end
  346. end Mark;
  347.  
  348. This pseudo-code procedure uses four auxiliary procedures. The procedure
  349. FirstPointerOffset determines the record field which contains the first
  350. pointer. The procedure NextPointerOffset repeatedly yields the next
  351. record field containing a pointer. A negative offset is used as a
  352. terminating sentinel.
  353.  
  354. To implement FirstPointerOffset and NextPointerOffset it must be
  355. possible to efficiently find out the offsets of a record's pointer
  356. fields. These offsets are the same for all variables of this record's
  357. type. Thus it is reasonable to provide a so-called type descriptor
  358. containing a table with all these offset values. Every heap record now
  359. needs a pointer to this type descriptor. This pointer is a hidden record
  360. field called a type tag and is usually located at offset -PtrSize in the
  361. record. The allocation procedure is extended such that it also
  362. initializes this tag. (For every record type, the compiler reserves a
  363. global variable anchoring the type descriptor. The contents of the
  364. appropriate variable is passed to the allocation routine as an
  365. additional parameter.)
  366.  
  367. Figure 1: Example of a record variable and its type descriptor
  368.  
  369. Figure 1 shows the descriptor of a type T . It contains the fields size
  370. and ptable . ptable is a table of pointer offsets describing where in a
  371. variable of type T a pointer can be found. This table, which varies from
  372. type to type, is terminated by a negative valued sentinel. The procedure
  373. Unmarked tests whether an object has already been marked, the procedure
  374. SetMark marks an object under the assumption that it is unmarked (i.e.
  375. Unmarked(q) is a precondition of SetMark(q) ). We won't go into details
  376. about how marking is realized. It should be sufficient to say that one
  377. bit of the type tag can be used for marking, usually either the sign bit
  378. or the least significant bit.
  379.  
  380. The following version of the above procedure replaces FirstPointerOffset
  381. and NextPointerOffset by an increment of the type tag by the size of a
  382. pointer:
  383.  
  384. procedure Mark(q:address);
  385. begin
  386.   if (q # NIL) & (Unmarked(q)) then
  387.     SetMark(q); Increment(Tag(q));
  388.     while mem[Tag(q)] >= 0 do
  389.       Mark(mem[q + mem[Tag(q)]]); Increment(Tag(q))
  390.     end;
  391.     RestoreTag(q)
  392.   end
  393. end Mark;
  394.  
  395. This means that the type tag of a record changes during the mark phase
  396. such that it always points to the offset to be processed and after the
  397. offsets already processed (see Figure 2).
  398.  
  399. Figure 2. Type Tag during a Mark Phase
  400.  
  401. The loop over the offsets terminates when a negative offset is found.
  402. The value of this offset can be initialized such that RestoreTag
  403. simply becomes
  404.  
  405.   Tag(q) := Tag(q) + mem[Tag(q)].
  406.  
  407. We now transform this procedure such that the guard (q # NIL) &
  408. (Unmarked(q)) is moved outside of the mark procedure.
  409.  
  410. procedure Mark(q:address);
  411.   var r:address;
  412. begin
  413.   (* (q # NIL) & JustMarked(q) *)
  414.   loop
  415.     Increment(Tag(q));
  416.     if mem[Tag(q)] >= 0 then
  417.       r := mem[q + mem[Tag(q)]];
  418.       if (r # NIL) & (Unmarked(r) then
  419.         SetMark(r); Mark(r)
  420.       end
  421.     else
  422.       RestoreTag(q);
  423.       return
  424.     end
  425.   end
  426. end Mark;
  427.  
  428. JustMarked means that the object is marked, but none of its descendants.
  429. To eliminate recursion, we introduce an explicit stack. The recursive
  430. call is replaced by Push(q); q := r and the RETURN is replaced by
  431. Pop(q):
  432.  
  433. procedure Mark(q:address);
  434.   var r:address;
  435. begin
  436.   Stack := Empty;
  437.   loop
  438.     Increment(Tag(q));
  439.     if mem[Tag(q)] >= 0 then
  440.       r := mem[q + mem[Tag(q)]];
  441.       if (r # NIL) & Unmarked(r) then
  442.         SetMark(r); Push(q); q := r
  443.       end
  444.     else
  445.       RestoreTag(q);
  446.       if Stack = Empty then
  447.         exit
  448.       else
  449.         Pop(q)
  450.       end
  451.     end
  452.   end
  453. end Mark;
  454.  
  455. The drawback of this procedure is the use of an additional stack, i.e.
  456. of additional memory. In the algorithm of Deutsch/Schorr/Waite [7], the
  457. stack is distributed to the individual pointer locations which are being
  458. traversed. We use a variable p as stack pointer, i.e. as pointer to the
  459. object containing the predecessor. The predecessor is contained in one
  460. of the pointer fields, namely the one currently being processed. The old
  461. value of this pointer field is either held in the auxiliary variable r
  462. or on the stack also. This leads to the following replacements:
  463.  
  464. Stack = Empty ->
  465.   p = NIL
  466.  
  467. Push(q) ->
  468.   mem[q + mem[Tag(q)]] := p; p := q
  469.  
  470. Pop(q) ->
  471.   a := p + mem[Tag[p]]; r := mem[a]; mem[a] := q; q := p; p := r
  472.  
  473. procedure Mark(q:address);
  474.   var p, r, a:address;
  475. begin
  476.   p := NIL;
  477.   loop
  478.     Increment(Tag(q));
  479.     if mem[Tag(q)] >= 0 then
  480.       r := mem[q + mem[Tag(q)]];
  481.       if (r # NIL) & Unmarked(r) then
  482.         SetMark(r); mem[q + mem[Tag(q)]] := p; p := q; q := r
  483.       end
  484.     else
  485.       RestoreTag(q);
  486.       if p = NIL then exit
  487.       else
  488.        a := p + mem[Tag[p]]; r := mem[a]; mem[a] := q; q := p; p := r
  489.       end
  490.     end
  491.   end
  492. end Mark;
  493.  
  494. In the appendix there is a listing of an actual implementation of the
  495. mark procedure written in MC68000 assembly language. This implementation
  496. also takes into consideration that additional data (which is not
  497. important for our discussion) must be stored in the type descriptor,
  498. between the size field and ptable .
  499.  
  500. Concerning the type descriptors we should add that they may be treated
  501. just as any other records. Thus they need their own type descriptors.
  502. These meta type descriptors differ only in their size fields. They in
  503. turn can share a common meta meta type descriptor, whose tag points back
  504. to itself, i.e. it is its own type descriptor. It may be more practical
  505. though to mark type descriptors in some way and to treat them as special
  506. cases.
  507.  
  508. Sweep  Phase
  509.  
  510. In the sweep phase the heap is traversed sequentially, block by block.
  511. To do that, the size of all blocks must be known. The sum of a block's
  512. address and its size yields the address of the next block. Since there
  513. is a type tag at the beginning of each allocated block, such a block's
  514. size can be found by inspecting the type descriptor to which the tag
  515. points. A free block can be treated the same way, with the difference
  516. that it is its own "type descriptor". How this can be done is shown in
  517. Figure 3.
  518.  
  519. Figure 3: Structure of a free block
  520.  
  521. At the beginning of the sweep phase, the free lists are all cleared. The
  522. sweep constructs completely new free lists by treating consecutive
  523. unmarked blocks as single large blocks and inserting them in the
  524. appropriate free lists. All marks are cleared.
  525.  
  526. procedure Scan;
  527.   var p: address;
  528. begin
  529.   A[1..N] := NIL;
  530.   q := HeapStart;
  531.   repeat
  532.     while (q # MemSize) & Marked(q) do
  533.       ResetMark(q); q := q + mem[mem[q]]
  534.     end;
  535.     if q # MemSize then
  536.       p := q;
  537.       repeat
  538.         q := q + mem[mem[q]]
  539.       until (q = MemSize) or Marked(q);
  540.       Insert(p, q - p)
  541.     end
  542.   until q = MemSize
  543. end Scan;
  544.  
  545. The procedure Insert(p, s) inserts a free block at address p in the free
  546. list for size s . The invariant over this "merge-sweep" is that all free
  547. blocks that have been traversed already are of maximal size, i.e.
  548. merged. Only the block visited most recently might have to be merged
  549. with the next one. This invariant is a principal difference between the
  550. merge-sweep deallocation and the deallocation of arbitrary blocks.
  551.  
  552. Acknowledgements
  553.  
  554. We would like to thank H. Mössenböck, N. Wirth, R. Griesemer and W. Weck.
  555.  
  556. References
  557.  
  558. 1. Wirth N (1988) The Programming Language Oberon. Software-Practice and
  559. Experience, 18 (7), 661-670
  560.  
  561. 2. Wirth N, Gutknecht J (1989) The Oberon System. Software-Practice and
  562. Experience, 19 (9), 857-893
  563.  
  564. 3. Eberle H (1987) Development and Analysis of a Workstation Computer,
  565. Ph. D. thesis no. 8431, ETH Zürich
  566.  
  567. 4. Knuth D (1973) The Art of Computer Programming, Addison-Wesley
  568.  
  569. 5. McCarthy J (1960) Recursive Functions of Symbolic Expressions and
  570. Their Computation by Machine, I, Comm. ACM, 3, 184-195
  571.  
  572. 6. Ungar D, Jackson F (1988), Tenuring Policies for Generation-Based
  573. Storage Reclamation, OOPSLA `88 Proceedings, 107-118
  574.  
  575. 7. Schorr H, and Waite W (1967), An efficient machine-independent
  576. procedure for garbage collection in various list structures, Comm. ACM,
  577. 10 (8), 501-505 Appendix
  578.  
  579. The following listing shows an implementation of the mark phase for one
  580. root pointer in MC68000 assembly language. A complete implementation
  581. would additionally have to iterate over all global (and possibly all
  582. local) pointer variables as roots.
  583.  
  584. Note that the mark bit in the type tag is set during the whole traversal
  585. of a record, thus it can be statically compensated for by using an
  586. offset of -1 when addressing relative to the type tag.
  587.  
  588. * 68000 mark phase for garbage collector
  589. * A0: pointer to father
  590. * A1: pointer to node
  591. * A2: temporary, for pointer rotation
  592. * A3: tag or pointer to current pointer offset
  593. *     pointer offsets are usually accessed via A3 with an offset of
  594. *     Offset(ptable) - 4 - 1.
  595. * The pointer is incremented before it is accessed, thus the subtraction
  596. * of PtrSize.
  597. * The subtraction of 1 comes from the set mark bit (bit # 0).
  598. * D0: offset
  599. * D1: temporary
  600.  
  601. PtrSize EQU  4    ;size of pointers and offsets
  602. Tag     EQU -4    ;offset of type tag
  603. TagL    EQU Tag+3 ;low byte of type tag
  604. Mark    EQU 0     ;mark bit (in TagL)
  605. PTab    EQU 36    ;ptable offset
  606. Offset  EQU PTab-PtrSize-1
  607.  
  608. Start:  MOVE.L  A1,D1           ; NIL test
  609.         BEQ     End             ; NIL
  610.         BSET.B  #Mark,TagL(A1)  ; test and set mark bit
  611.         BNE     End             ; marked
  612.         MOVE.L  #0,A0           ; father := NIL
  613.         MOVE.L  Tag(A1),A3      ; load first tag
  614.         BRA     Loop
  615. Up:     ADD.L   D0,A3           ; adjust tag
  616.         MOVE.L  A3,Tag(A1)      ; save tag
  617.         MOVE.L  A0,D1           ; NIL test
  618.         BEQ     End             ; father = NIL (sentinel)
  619.         MOVE.L  Tag(A0),A3      ; load father.tag
  620.         MOVE.L  Offset(A3),D0   ; load offset
  621.         MOVE.L  (A0,D0),A2      ; rotate pointers, step 1
  622.         MOVE.L  A1,(A0,D0)      ; rotate pointers, step 2
  623.         MOVE.L  A0,A1           ; rotate pointers, step 3
  624.         MOVE.L  A2,A0           ; rotate pointers, step 4
  625. Loop:   ADDQ.L  #PtrSize,A3     ; address of next offset
  626.         MOVE.L  Offset(A3),D0   ; load next offset
  627.         BMI     Up              ; negative sentinel reached, i.e. end of
  628.                                 ; list
  629.         MOVE.L  (A1,D0),A2      ; load son (and rotate pointers, step 1)
  630.         MOVE.L  A2,D1           ; NIL test
  631.         BEQ     Loop            ; NIL
  632.         BSET.B  #Mark,TagL(A2)  ; test and set mark bit
  633.         BNE     Loop            ; marked
  634. Down:   MOVE.L  A3,Tag(A1)      ; save tag
  635.         MOVE.L  A0,(A1,D0)      ; rotate pointers, step 2
  636.         MOVE.L  A1,A0           ; rotate pointers, step 3
  637.         MOVE.L  A2,A1           ; rotate pointers, step 4
  638.         MOVE.L  Tag(A1),A3      ; load new tag
  639.         BRA     Loop
  640. End:
  641.  
  642. ----------------------------------------------------------------------------
  643.  
  644. 3. Type Guards and Type Tests
  645. Cuno Pfister
  646.  
  647. In Oberon, indirectly referenced record variables (i.e. referenced by
  648. pointer or passed as VAR parameter) may have a different type at
  649. run-time than the one which is declared statically. An Oberon
  650. implementation must guarantee that the actual type of a record is an
  651. extension of the record's declared type. This is done with the aid of
  652. type guards [1]: A type guard tests whether the type of an indirectly
  653. referenced record variable is an extension of some statically declared
  654. type. If not, the program is aborted. A type test is similar to a type
  655. guard, but instead of aborting a program it returns the value FALSE,
  656. otherwise TRUE. We present a scheme which allows a very efficient
  657. implementation of type guards and type tests.
  658.  
  659. A record type is represented at run-time by a type descriptor (see
  660. Figure). In this type descriptor there is a table of pointers (ttable),
  661. at a fixed offset and with a fixed size. The pointer in entry 0 points
  662. to the type descriptor of the original base type of the extension
  663. hierarchy (level 0 type). Entry 1 points to the first extension (level 1
  664. type), entry 2 to the extension of the first extension, and so on. If
  665. the type descriptor denotes a level n type, the first n + 1 entries are
  666. used. The entries for higher level types are set to NIL. The level 0
  667. entry may even be omitted, since a type guard on a base type is never
  668. executed at run-time. Nevertheless it is recommended to include it, for
  669. an example of where it can be useful see technical note # 4.
  670.  
  671. Obviously the depth of the extension hierarchy is limited by such an
  672. arrangement. We recommend a table size of about 8 entries. This is
  673. thought to be large enough for all practical purposes.
  674.  
  675. ttable
  676. type descriptor
  677. record
  678. p
  679. tag
  680. size
  681. ptable
  682.  
  683. The generated code can be described as follows:
  684.  
  685. the type guard v(T) becomes
  686.  
  687.   p := Tag(v);
  688.   IF p^.ttable[L] # Tadr THEN HALT(18) END
  689.  
  690. and the type test v IS T becomes
  691.  
  692.   p := Tag(v);
  693.   RETURN p^.ttable[L] = Tadr
  694.  
  695. where L is the extension's level, and Tadr the address of T 's type
  696. descriptor. T is a hidden global variable in the module which declares
  697. type T .
  698.  
  699. Tag(v) is different for a record referenced via pointer and for a VAR
  700. parameter. The former contains the tag in the record itself, while the
  701. latter's tag is passed as an implicit parameter, together with the
  702. address of the record. A guard applied to a NIL valued pointer aborts
  703. the program.
  704.  
  705. The WITH statement produces the same code as a type guard, the
  706. difference is only relevant for the compiler. A similar scheme has been
  707. presented in [1].
  708.  
  709. Hidden type guards are generated for the assignment of one record to
  710. another, indirectly referenced record variable. In this case the
  711. implementation must enforce strict equality of the record types on both
  712. sides of the assignment. This leads to a simpler type guard, namely:
  713.  
  714. p := Tag(v);
  715. IF p # Tadr THEN HALT(19) END
  716.  
  717. References
  718.  
  719. 1. Cohen N H (1989), Type-Extension Type Tests Can Be Performed in
  720. Constant Time, IBM Research Report
  721.  
  722. 2. Wirth N (1988), Type Extensions, ACM Trans. on Programming Languages
  723. and Systems, Vol. 10, No. 2, 204-214
  724.  
  725. ----------------------------------------------------------------------------
  726.  
  727. 4. A Symmetric Solution to the Load/Store Problem
  728. J. Templ  1.3.91
  729.  
  730. The problem of loading and storing polymorphic data structures from or
  731. to files using load and store messages is usually considered to be
  732. asymmetric because an object existing in memory can receive a store
  733. message but an object existing on a file cannot receive a load message.
  734. Nevertheless a symmetric solution for the problem is proposed. It is
  735. argued that a symmetric solution is both, more beautiful and more
  736. flexible. The key to a symmetric solution is in the separation of the
  737. information associated with an object into a header and a contents part.
  738. The header contains the type information and the contents part contains
  739. the data associated with the object. As the type information is not
  740. maintained by the object itself but by the class the object belongs to,
  741. it is straight forward to use class methods (ordinary procedures) to
  742. handle the type information and to use instance methods (type bound
  743. procedures or message handlers) to handle the contents of an object. In
  744. the proposed solution all classes handle the type information the same
  745. way, therefore one can think of the type handling methods as meta class
  746. methods. When dealing with extended types, the problem of loading and
  747. storing inherited state (possibly invisible to the extended type)
  748. arises. Using inherited load and store methods (super-calls) solves the
  749. problem but there is a subtle point to observe. When the type
  750. information is handled by the object itself instead of by the (meta)
  751. class, each overriding method is forced to use super calls. Also super
  752. calls must be done before any other data is stored onto the file. The
  753. more flexible symmetric solution follows postulate 1:
  754.  
  755. "An object never stores its own type information as response to a store
  756. message"
  757.  
  758. Loading an object o using a Rider R may be done by a procedure
  759. ReadObj(R, o) that generates an object according to the header
  760. information. Then the object's data can be loaded by sending a load
  761. message, e.g. o.Load(R).
  762.  
  763. $ object = header contents.
  764.  
  765. Storing an object o using a Rider R may be done by a procedure
  766. WriteObj(R, o). Storing the contents of the object may be done by
  767. sending a store message o.Store(R).
  768.  
  769. Let T be a subtype of Object and T1 a subtype of T. Let Load and Store
  770. be procedures bound to T and Load' and Store' procedures bound to T1
  771. overriding and invoking the inherited procedures. Storing of an object v
  772. with dynamic type T1 to a file is then done by the following steps:
  773.  
  774. 1. WriteObj(R, v);
  775. 2. v.Store(R) invokes Store'
  776.   2.1. v.Store^(R) in Store' invokes Store
  777.     2.1.1. data associated with type T is stored
  778.   2.2. additional data associated with type T1 is stored
  779.  
  780. Loading of an object of type T1 from a file into a variable v is done in
  781. symmetric steps:
  782.  
  783. 1. ReadObj(R, v);
  784. 2. v.Load(R) invokes Load'
  785.   2.1. v.Load^(R) in Load' invokes Load
  786.     2.1.1. data associated with type T is loaded
  787.   2.2. additional data associated with type T1 is loaded
  788.  
  789. ReadObj and WriteObj are responsible for internalizing and externalizing
  790. the object's type information. For internalized objects this information
  791. consists of a type tag, i.e. a pointer to a type descriptor node unique
  792. for a type. For externalized objects the type tags are mapped to
  793. reference numbers that refer to the type of the object. The first
  794. occurence of a type reference is followed by the externalized type
  795. descriptor consisting of the name of the module defining the type and
  796. the type's name.
  797.  
  798. $ header = ref [module type].
  799. $ ref = integer.
  800. $ module = char {char} 0X.
  801. $ type = char {char} 0X.
  802.  
  803. For easy maintenance of the reference numbers of types, a ref field in
  804. the type descriptor is assumed. To avoid resetting this field before
  805. each "store session", a global virtual clock (store counter) is
  806. introduced and instead of the reference number in the type descriptors a
  807. time stamp is actually used. This time stamp contains the clock value of
  808. the type's last externalization. The reference number written to the
  809. file is the difference between the time stamp and the start time
  810. (clock0) of the stores which is defined by calling a Reset procedure.
  811. For "load sessions" a type table and a type counter has to be maintained
  812. which are also initialized by the same Reset procedure. For more details
  813. see the prototype implementation below. The use of the Reset procedure
  814. is restricted by postulate 2:
  815.  
  816. "The initialization of the generic load/store mechanism must be symmetric"
  817.  
  818. More accuratly, each Reset call preceding a store sequence must
  819. correspond to a Reset call preceding a load sequence and vice versa.
  820. Normally, the resets are done on the level of user activated commands.
  821.  
  822. A module Files1 is assumed to support persistent data portable across
  823. different Oberon implementations. Files1 contains procedures for loading
  824. and storing basic types (integers, reals, ...) in a portable way and it
  825. contains procedures to load and store the empty object, i.e. it handles
  826. the dynamic type information associated with an object derived from
  827. Files1.Object.
  828.  
  829. Properties of the proposed solution:
  830.   - no install mechanism required
  831.   - efficient externalization and internalization
  832.   - no additional storage in internalized objects
  833.   - compact external representation
  834.   - easy to implement
  835.   - low space overhead in type descriptors (time stamp plus type name)
  836.   - flexible in the use of super-calls
  837.   - pure Oberon (language)
  838.  
  839. A prototype of module Files1 has been implemented under SPARC-Oberon:
  840.  
  841. MODULE Files1;  (* J.Templ, 24.2.91 *)
  842. IMPORT SYSTEM, Files, Kernel, Modules;
  843.  
  844. TYPE
  845.   Object* = POINTER TO ObjectDesc;
  846.   ObjectDesc* = RECORD END ;
  847.  
  848.   TDesc = POINTER TO RECORD
  849.     m: Kernel.Module;
  850.     name: ARRAY 24 OF CHAR;
  851.     time: LONGINT   (* < clock *)
  852.   END ;
  853.  
  854. VAR
  855.   module*, type*: ARRAY 24 OF CHAR;
  856.   (* most recent internalized type *)
  857.   clock, noftypes: LONGINT;       (* clock0 = clock - noftypes *)
  858.   typTab: ARRAY 256 OF LONGINT;
  859. ...
  860.  
  861. PROCEDURE New(typetag: LONGINT): Object;
  862. ...
  863. END New;
  864.  
  865. PROCEDURE ThisType(m: Kernel.Module; VAR type: ARRAY OF CHAR): LONGINT;
  866. ...
  867. END ThisType;
  868.  
  869. PROCEDURE Reset*;
  870. BEGIN noftypes := 0
  871. END Reset;
  872.  
  873. PROCEDURE ReadObj* (VAR R: Files.Rider; VAR o: Object);
  874.   VAR ref, tag: LONGINT; m: Kernel.Module;
  875. BEGIN
  876.   Read(R, ref);
  877.   IF ref = noftypes THEN
  878.     ReadString(R, module);
  879.     ReadString(R, type);
  880.     m := Modules.ThisMod(module);
  881.     IF m # NIL THEN tag := ThisType(m, type);
  882.       IF tag # 0 THEN typTab[ref] := tag; INC(noftypes);
  883.       o := New(typTab[ref])
  884.       ELSE R.res := 1
  885.       END
  886.     ELSE R.res := 2
  887.     END
  888.   ELSIF ref # -1 THEN o := New(typTab[ref])
  889.   ELSE o := NIL
  890.   END
  891. END ReadObj;
  892.  
  893. PROCEDURE WriteObj* (VAR R: Files.Rider; o: Object);
  894.   VAR tag: TDesc; t: LONGINT;
  895. BEGIN
  896.   IF o # NIL THEN
  897.     SYSTEM.GET(SYSTEM.VAL(LONGINT, o)-4, t);
  898.     tag := SYSTEM.VAL(TDesc, t - 36);
  899.     IF tag.time < clock - noftypes THEN
  900.       Write(R, noftypes);
  901.       Files1.Write(R, noftypes);
  902.       tag.time := clock;
  903.       INC(noftypes); INC(clock);
  904.       Files1.WriteString(R, tag.m.name);
  905.       Files1.WriteString(R, tag.name)
  906.     ELSE Write(R, tag.ref)
  907.     ELSE Files1.Write(R, tag.time - (clock - noftypes))
  908.     END
  909.   ELSE Write(R, -1)
  910.   END
  911. END WriteObj;
  912.  
  913. BEGIN clock := 1; noftypes := 0
  914. END Files1.
  915.  
  916. Example: loading and storing a binary tree using type bound procedures.
  917.  
  918. TYPE
  919.   Tree = POINTER TO TreeDesc;
  920.   TreeDesc = RECORD
  921.     (Files1.ObjectDesc)
  922.     left, right: Tree
  923.   END
  924.  
  925. PROCEDURE (t: Tree) Load (VAR R: Files.Rider);
  926. BEGIN
  927.   Files1.ReadObj(R, t.left);
  928.   IF t.left # NIL THEN t.left.Load(R) END ;
  929.   Files1.ReadObj(R, t.right);
  930.   IF t.right # NIL THEN t.right.Load(R) END ;
  931. END Load;
  932.  
  933. PROCEDURE (t: Tree) Store (VAR R: Files.Rider);
  934. BEGIN
  935.   Files1.WriteObj(R, t.left);
  936.   IF t.left # NIL THEN t.left.Store(R) END ;
  937.   Files1.WriteObj(R, t.right);
  938.   IF t.right # NIL THEN t.right.Store(R) END ;
  939. END Store;
  940.  
  941. PROCEDURE StoreCmd*;
  942.   ...
  943.   Files1.Reset;
  944.   Files1.WriteObj(R, t);
  945.   IF t # NIL THEN t.Store(R) END
  946. END StoreCmd;
  947.  
  948. PROCEDURE LoadCmd*;
  949.   ...
  950.   Files1.Reset;
  951.   Files1.ReadObj(R, t);
  952.   IF t # NIL THEN t.Load(R) END
  953. END LoadCmd;
  954.  
  955. Note that an asymmetric solution which stores the type information of an
  956. object as response to the store message is not significantly shorter
  957. because NIL pointers have to be handled explicitly. It also has the
  958. disadvantage that the external representation of NIL has to be known
  959. (unless a special procedure that stores the value NIL has been
  960. introduced).
  961.  
  962. PROCEDURE StoreCmd*;
  963. (* the asymetric solution *)
  964.   ...
  965.   Files1.Reset;
  966.   IF t # NIL THEN t.Store(R)
  967.   ELSE Files1.Write(R, 0)
  968.   END
  969. END StoreCmd;
  970.  
  971. The following presents the complete interface of module Files1 together
  972. with a short description of the external data representation.
  973.  
  974. DEFINITION Files1;
  975. (*J.Templ 31.1.91*)
  976. (* module to support portable persistent data.
  977.  
  978. ReadInt, WriteInt: 2 Byte integers, little endian byte ordering
  979. ReadLInt, WriteLInt: 4 Byte integers, little endian byte ordering
  980. ReadSet, WriteSet: 4 byte sets, little endian byte ordering, ORD({0}) = 1
  981. ReadReal, WriteReal: 4 byte IEEE reals, little endian byte ordering
  982. ReadLReal, WriteLReal: 8 byte IEEE reals, little endian byte ordering
  983. ReadString, WriteString: arbitrary length, null terminated
  984. Read, Write: compact integers, 1 to 5 byte, cf. ETH Report 133, 1990 *)
  985.  
  986. IMPORT Files;
  987.  
  988. TYPE
  989.   Object = POINTER TO ObjectDesc;
  990.   ObjectDesc = RECORD END ;
  991.  
  992. VAR module, type: ARRAY 24 OF CHAR;
  993.  
  994. PROCEDURE Read (VAR R: Files.Rider; VAR i: LONGINT);
  995. PROCEDURE ReadInt (VAR R: Files.Rider; VAR i: INTEGER);
  996. PROCEDURE ReadLInt (VAR R: Files.Rider; VAR i: LONGINT);
  997. PROCEDURE ReadLReal (VAR R: Files.Rider; VAR r: LONGREAL);
  998. PROCEDURE ReadReal (VAR R: Files.Rider; VAR r: REAL);
  999. PROCEDURE ReadSet (VAR R: Files.Rider; VAR s: SET);
  1000. PROCEDURE ReadString (VAR R: Files.Rider; VAR s: ARRAY OF CHAR);
  1001. PROCEDURE ReadObj (VAR R: Files.Rider; VAR o: Object);
  1002. PROCEDURE Write (VAR R: Files.Rider; i: LONGINT);
  1003. PROCEDURE WriteInt (VAR R: Files.Rider; i: INTEGER);
  1004. PROCEDURE WriteLInt (VAR R: Files.Rider; i: LONGINT);
  1005. PROCEDURE WriteLReal (VAR R: Files.Rider; r: LONGREAL);
  1006. PROCEDURE WriteReal (VAR R: Files.Rider; r: REAL);
  1007. PROCEDURE WriteSet (VAR R: Files.Rider; s: SET);
  1008. PROCEDURE WriteString (VAR R: Files.Rider; VAR s: ARRAY OF CHAR);
  1009. PROCEDURE WriteObj (VAR R: Files.Rider; o: Object);
  1010. PROCEDURE Reset;
  1011.  
  1012. END Files1.
  1013.  
  1014. ----------------------------------------------------------------------------
  1015.  
  1016. 5. Garbage Collection on Open Arrays
  1017.  
  1018. J. Templ 3.3.91
  1019.  
  1020. Traditional garbage collectors for Oberon ignore the problem of
  1021. traversing array structures on the heap by assuming that the compiler
  1022. forbids such constructs (implementation restriction). However, there are
  1023. good reasons for supporting pointers to arrays (fixed size and open
  1024. arrays) with arbitrary element types and at the same time eliminating
  1025. the implementation restriction. This paper proposes a solution for
  1026. traversing array data structures that affects the inner loop of the
  1027. garbage collector's mark phase in the common case of traditional record
  1028. nodes only by two simple assignments when following a pointer (two
  1029. register moves on most processors). The outer loop needs two additional
  1030. bit tests (within registers). Although the mark phase can be formulated
  1031. without nested loops, one can think of the highly time critical
  1032. operations performed on each pointer of a node (skipping nil pointers,
  1033. skipping pointers that point to marked blocks, and following a pointer)
  1034. as the "inner loop". The "outer loop" contains all operations performed
  1035. on each block, i.e. the inner loop and some operations when leaving the
  1036. node. In other words, the inner loop is executed O(N) times, where N is
  1037. the number of reachable pointers, and the outer loop is executed O(M)
  1038. times, where M is the number of reachable blocks. It is obvious that N
  1039. >= M and in some cases N >> M. Let T, Elem and P be types as defined
  1040. below and v be a variable of type P.
  1041.  
  1042. TYPE
  1043.   T = ARRAY n0, n1 .. ni-1 OF Elem;
  1044.   Elem = RECORD ... END ;
  1045.   P = POINTER TO T;
  1046.  
  1047. The proposed algorithm assumes a storage block pointed to by v to look
  1048. like this:
  1049.  
  1050. v-4   tag points to Elem type descriptor
  1051. v --> data points to the first array element
  1052.       size n0 * n1 * .. * ni-1 * SIZE(Elem)
  1053.       arrpos reserved for the garbage collector
  1054.  
  1055. The type descriptor of an array block is the type descriptor of the
  1056. element type which must be a record. Multi-dimensional arrays are
  1057. "flattened", i.e. they are treated like big one-dimensional arrays.
  1058. Arrays within records are not affected, i.e. they are still expanded in
  1059. the type descriptor of the record. In addition to the existing block
  1060. kinds SysBlk (a block allocated with SYSTEM.NEW) and RecordBlk (a block
  1061. allocated with NEW), a new kind ArrayBlk is defined, i.e. now there are
  1062. three different kinds of heap blocks. The mark phase of a garbage
  1063. collector supporting only SysBlk and RecordBlk looks like the following
  1064. procedure Mark that traverses all nodes reachable from the node pointed
  1065. to by q. Mark expects the parameter q to point to a marked record block.
  1066.  
  1067. PROCEDURE Mark(q: Pointer);
  1068.   VAR n: Pointer;
  1069. BEGIN
  1070.   q.cnt := 0;
  1071.   LOOP
  1072.     IF Traversed(q) THEN Reset(q);
  1073.       IF StackEmpty THEN EXIT END ;
  1074.       Pop(q)
  1075.     ELSE
  1076.       Pointer(q, n);
  1077.       IF (n # NIL) & Unmarked(n) THEN SetMark(n);
  1078.         IF RecordBlk(n) THEN Push(q); q := n; q.cnt := -1 END
  1079.       END
  1080.     END ;
  1081.     INC(q.cnt)
  1082.   END
  1083. END Mark;
  1084.  
  1085. The meaning of the macros is as follows (some of them will be used later):
  1086.  
  1087. RecordBlk(q), ArrayBlk(q), SysBlk(q), Unmarked(q)
  1088.   check a particular bit combination usually encoded in the type tag of q
  1089. SetMark(q)
  1090.   set a bit combination in the type tag of q to signal that q is reachable
  1091. Traversed(q)
  1092.   true iff all nodes reachable from q are marked.
  1093.   offset := Offset(q, q.cnt);
  1094.   RETURN offset < 0
  1095. Reset(q)
  1096.  resets some information temporarily encoded in the type tag of q
  1097. StackEmpty
  1098.   true if stack of partially traversed nodes is empty
  1099. Pointer(q, n)
  1100.   set n to the next son of q to be traversed.
  1101.   offset := q.tag.PtrTab[q.cnt];
  1102.   n := mem[q+offset]
  1103. Push(q)
  1104.   Push q onto the stack of partially traversed nodes.
  1105.   offset := Offset(q, q.cnt);
  1106.   mem[q+offset] := tos; tos := q
  1107. Pop(q)
  1108.   Pop q from the stack of partially traversed nodes.
  1109.   offset := Offset(tos, tos.cnt);
  1110.   n := mem[tos+offset]; mem[tos+offset] := q; q := tos; tos := n
  1111. Offset(q, n)
  1112.   the offset of the n-th pointer in block q
  1113. Elemsize(q)
  1114.   the size of one array element.
  1115.  
  1116. Elemsize(q) should be expandable to q.tag.size, i.e. the size of the
  1117. element type should be available in the type descriptor. Most Oberon
  1118. implementations currently round the record size available in the type
  1119. descriptor to the next power of two or to the next number divisible by
  1120. 16 or the like. In this case, the element size must be included in the
  1121. array block needing some additional space. q.cnt the number of sons of q
  1122. that are already traversed
  1123.  
  1124. To include array blocks, we apply the mark algorithm iteratively to all
  1125. array elements in the same way as it is done for records. For array
  1126. blocks q.arrpos is used to hold the offset of the current array element,
  1127. i.e. q.arrpos DIV Elemsize(q) holds the number of fully traversed array
  1128. elements. q.cnt gives the number of sons of the element pointed to by
  1129. q.arrpos that are already traversed. Mark now expects the parameter q to
  1130. point to a marked record or array block.
  1131.  
  1132. PROCEDURE Mark(q: Pointer);
  1133.   VAR n: Pointer;
  1134. BEGIN
  1135.   IF ArrayBlk(q) THEN q.arrpos := 0 END;
  1136.   q.cnt := 0;
  1137.   LOOP
  1138.     IF Traversed(q) THEN
  1139.       Reset(q);
  1140.       IF ArrayBlk(q) & (q.arrpos + Elemsize(q) # q.size) THEN
  1141.         INC(q.arrpos, Elemsize(q)); q.cnt := -1
  1142.       ELSIF StackEmpty THEN EXIT
  1143.       ELSE Pop(q)
  1144.       END
  1145.     ELSE
  1146.       Pointer(q, n);
  1147.       IF (n# NIL) & Unmarked(n) THEN
  1148.         SetMark(n);
  1149.         IF RecordBlk(n) OR ~SysBlk(n) THEN Push(q); q := n; q.cnt := -1 END
  1150.       END
  1151.     END ;
  1152.     INC(q.cnt)
  1153.   END
  1154. END Mark;
  1155.  
  1156. Unfortunately every macro that accesses a pointer in q needs to
  1157. distinguish between Record and Array blocks now. For the Pointer macro
  1158. the situation is like this:
  1159.  
  1160. Pointer(q, n) =
  1161.   offset := Offset(q, q.cnt);
  1162.   IF ArrayBlk(q) THEN n := mem[q.data + q.arrpos + offset]
  1163.   ELSE n := mem[q + offset]
  1164.   END
  1165.  
  1166. To avoid this distinction, we introduce an auxiliary variable t and an
  1167. auxiliary invariant:
  1168.  
  1169. H(t, q): <=> (RecordBlk(q) & t = q) OR (ArrayBlk(q) & t = q.data + q.arrpos)
  1170. Pointer(q, t, n) =
  1171.   offset := Offset(q, q.cnt);
  1172.   n := mem[t + offset]
  1173. Push(q, t) =
  1174.   offset := Offset(q, q.cnt);
  1175.   mem[t + offset] := tos; tos := q
  1176. Pop(q, t) =
  1177.   offset := Offset(tos, tos.cnt);
  1178.   IF ArrayBlk(tos) THEN t := tos.data + tos.arrpos
  1179.   ELSE t := tos
  1180.   END;
  1181.   n := mem[t + offset]; mem[t + offset] := q; q := tos; tos := n
  1182.  
  1183. t must be set appropriately when entering a node, but it remains
  1184. unchanged while looping over nil pointers, marked pointers, or sysblks
  1185. within a node. The overhead when pushing a record node is only a single
  1186. assignment (shown in italics), the overhead for pushing an array node is
  1187. one additional test and two assignments. The overhead for returning from
  1188. a record node is two bit-tests and one assignment (shown in italics),
  1189. for finishing array elements, another test for detecting the end of the
  1190. array is needed.
  1191.  
  1192. PROCEDURE Mark(q: Pointer);
  1193.   VAR n, t: Pointer;
  1194. BEGIN
  1195.   IF ArrayBlk(q) THEN q.arrpos := 0; t := q.data ELSE t := q END ;
  1196.   q.cnt := 0;
  1197.   LOOP {H}
  1198.     IF Traversed(q) THEN Reset(q);
  1199.       IF ArrayBlk(q) & (q.arrpos + Elemsize(q) # q.size) THEN
  1200.         INC(q.arrpos, Elemsize(q)); q.cnt := -1; INC(t, Elemsize(q))
  1201.       ELSIF StackEmpty THEN
  1202.         EXIT
  1203.       ELSE
  1204.         Pop(q, t)
  1205.       END
  1206.     ELSE
  1207.       Pointer(q, t, n);
  1208.       IF (n # NIL) & Unmarked(n) THEN
  1209.         SetMark(n);
  1210.         IF RecordBlk(n) THEN
  1211.           Push(q, t); q := n; t := q; q.cnt := -1
  1212.         ELSIF ~SysBlk(n) THEN
  1213.           Push(q, t); q := n; q.arrpos := 0; t := q.data; q.cnt := -1
  1214.         END
  1215.       END
  1216.     END ;
  1217.     INC(q.cnt)
  1218.   END
  1219. END Mark;
  1220.  
  1221. The modest additional complexity of the solution and the small runtime
  1222. overhead for record blocks (shown in italics) seem to be justified by
  1223. the additional functionality.
  1224.  
  1225. In practice it turns out that a sophisticated encoding of the predicates
  1226. ArrayBlk(q), SysBlk(q), RecordBlk(q), and Unmarked(q) has to be used to
  1227. get a fast collector. The encoding used in a prototype implementation in
  1228. SPARC-Oberon is explained below using an Oberon-like notation with
  1229. relaxed typing rules, e.g. q.tag is sometimes used as a set, sometimes
  1230. as a pointer, and sometimes as an integer. To avoid confusion, set
  1231. operators are indexed with s. It is assumed that sets, pointers and
  1232. integers have 4 bytes, and that bit i corresponds to value 2^i.
  1233.  
  1234. Predicate     Encoding       Invariant
  1235.  
  1236. Unmarked(q)   ~(0 IN q.tag)
  1237. RecordBlk(q)  ~(1 IN q.tag)  RecordBlk(q) => ~SysBlk(q)
  1238. ArrayBlk(q)   1 IN q.tag
  1239. SysBlk(q)     2 IN q.tag     SysBlk(q) => ArrayBlk(q)
  1240. free(q)       3 IN q.tag
  1241.  
  1242. These encodings follow the rule that an allocated unmarked record block
  1243. should not have any auxiliary bits set in the type tag, i.e. it should
  1244. have a valid type tag without masking some bits first. This is important
  1245. for fast type guards and type tests during program execution. For
  1246. counting the number of sons already visited, the technique proposed by
  1247. B. Heeb is used. Therefore the type tag is used as a pointer into the
  1248. offset table, too. The pointer offsets are 4 byte integers, i.e. only
  1249. the low order two bits of the tag can be used for Unmarked and
  1250. RecordBlk. Fortunately, SysBlk is never used when traversing a node, as
  1251. system blocks are supposed to have no pointers at all. free(q) is used
  1252. by the scan phase of the collector. Using 4 bits in the type tag forces
  1253. type descriptors to a 16 byte alignment. Note that the type tag can only
  1254. be used as a pointer after masking the low order bits. In the following
  1255. mem[p] means the 4 byte word at memory location p.
  1256.  
  1257. PROCEDURE Mark(q: Pointer);
  1258.   VAR n, t, tos: Pointer; offset: LONGINT;
  1259. BEGIN
  1260.   IF ArrayBlk(q) THEN q.arrpos := 0; t := q.data ELSE t := q END ;
  1261.   INC(q.tag, PtrTabOffset); tos := NIL;
  1262.   LOOP {H}
  1263.     offset := mem[q.tag - {0, 1}];
  1264.     IF offset < 0 THEN INC(q.tag, offset);
  1265.       IF ArrayBlk(q) & (q.arrpos + Elemsize(q) # q.size) THEN
  1266.         INC(q.arrpos, Elemsize(q)); INC(q.tag, PtrTabOffset - 4);
  1267.         INC(t, Elemsize(q))
  1268.       ELSIF tos = NIL THEN EXIT
  1269.       ELSE Pop(q, t)
  1270.       END
  1271.     ELSE
  1272.       n := mem[t + offset];
  1273.       IF (n # NIL) & Unmarked(n) THEN
  1274.         INCL(n.tag, 0);
  1275.         IF RecordBlk(n) THEN
  1276.           Push(q, t); q := n; t := q; INC(q.tag, PtrTabOffset - 4)
  1277.         ELSIF ~SysBlk(n) THEN
  1278.           Push(q, t); q := n; q.arrpos := 0;
  1279.           t := q.data; INC(q.tag, PtrTabOffset - 4)
  1280.         END
  1281.       END
  1282.     END ;
  1283.     INC(q.tag, 4)
  1284.   END
  1285. END Mark;
  1286.  
  1287. The macros Push and Pop are now defined as:
  1288.  
  1289. Push(q, t) =
  1290.   mem[t + offset] := tos; tos := q
  1291.  
  1292. Pop(q, t) =
  1293.   offset := mem[tos.tag - {0, 1}];
  1294.   IF ArrayBlk(tos) THEN t := tos.data + tos.arrpos ELSE t := tos END;
  1295.   r := mem[t + offset]; mem[t + offset] := q; q := tos; tos := r
  1296.  
  1297. This procedure may be implemented using assembly language or "pseudo
  1298. Oberon" (Oberon + module SYSTEM). However, there are still some
  1299. improvements possible. The repeated access to mem[q.tag - {0, 1}] in the
  1300. inner loop can be accelerated by introducing an auxiliary variable tag
  1301. initialized with q.tag - {0, 1}. In this case, q.tag has to be updated
  1302. whenever a node is left. This update operation and the bit tests before
  1303. Pop may be optimized by introducing another variable qtag with qtag =
  1304. q.tag * {0,1}.
  1305.  
  1306. There are also some common subexpressions that could be eliminated (by a
  1307. compiler).
  1308.  
  1309. PROCEDURE Mark(q: Pointer);
  1310.   VAR n, t, tos: Pointer; offset, tag: LONGINT; qmask, ntag: SET;
  1311. BEGIN
  1312.   IF 1 IN q.tag THEN
  1313.     q.arrpos := 0; t := q.data; qmask := {0, 1}
  1314.   ELSE t := q; qmask := {0}
  1315.   END;
  1316.   tag := q.tag - {0, 1} + PtrTabOffset; tos := NIL;
  1317.   LOOP {H}
  1318.     offset := mem[tag];
  1319.     IF offset < 0 THEN
  1320.       q.tag := tag + offset + qmask;
  1321.       IF 1 IN qmask & (q.arrpos + Elemsize(q) # q.size) THEN
  1322.         INC(q.arrpos, Elemsize(q)); INC(tag, offset + PtrTabOffset - 4);
  1323.         INC(t, Elemsize(q))
  1324.       ELSIF tos = NIL THEN EXIT
  1325.       ELSE
  1326.         qmask := tos.tag; tag := qmask - {0, 1}; qmask := qmask * {0, 1};
  1327.         IF 1 IN qmask THEN t := tos.data + tos.arrpos
  1328.         ELSE t := tos
  1329.         END;
  1330.         offset := mem[tag]; n := mem[t + offset]; mem[t + offset] := q;
  1331.         q := tos; tos := n
  1332.       END
  1333.     ELSE
  1334.       n := mem[t + offset];
  1335.       IF (n # NIL) THEN
  1336.         ntag := n.tag;
  1337.         IF ~(0 IN ntag) THEN
  1338.           q.tag := tag + qmask; n.tag := ntag + {0};
  1339.           IF ~(1 IN ntag) THEN
  1340.             mem[t + offset] := tos; tos := q; q := n; t := q;
  1341.             tag := ntag + PtrTabOffset - 4; qmask := {0}
  1342.           ELSIF ~(2 IN ntag) THEN
  1343.             mem[t + offset] := tos; tos := q; q := n; q.arrpos := 0;
  1344.             t := q.data; tag := ntag - {1} + PtrTabOffset - 4;
  1345.             qmask := {0, 1}
  1346.           END
  1347.         END
  1348.       END
  1349.     END;
  1350.     INC(tag, 4)
  1351.   END
  1352. END Mark;
  1353.  
  1354. The overhead for record nodes is shown in italics. On modern processors
  1355. it consists of about two machine cycles when following a pointer to a
  1356. record node and six cycles when leaving a record node. Switching from
  1357. one array element to the next needs one additional compare, two storage
  1358. reads, one storage write, and three additions (15 - 20 cycles).
  1359.  
  1360.